perm filename FILLER.XLD[MSS,LCS] blob
sn#097565 filedate 1974-04-06 generic text, type T, neo UTF8
00005 C Q AND R ARE X,Y COORDS. NE(1)=WDCNT. OTHER NE'S HAVE 3
00007 C FOR INVIS. VECTORS. M=VERTICAL SCAN LINES
00010 SUBROUTINE FILLER(Q,R,NE,M)
00200 DIMENSION Q(1),R(2),NE(1)
00300 COMMON /RZ/RSZ,IPLT,RJB,CENTR
00500 KK=NE(1)
00600 KJ=2
00700 DO 4 K=2,KK
00800 IF(NE(K).NE.3)GO TO 11
00900 NE(K)=KJ
01000 KJ=K+1
01100 GO TO 4
01200 11 NE(K)=0
01300 4 CONTINUE
01310 DO 12 K=1,KK
01320 Q(K)=IFIX(Q(K))
01330 12 R(K)=IFIX(R(K))
01400 NE(KK+1)=KJ
01500 C FINDS JUMPS
02200 DO 2 J=2,KK
02300 IF(NE(J).GT.0.OR.Q(J).EQ.Q(J-1))GO TO 2
02400 C SKIPS VERTICAL LINES
02410 X=HALF(Q,J)+.00001
02500 C MIDPOINT OF LINE
02600 ALT=HALF(R,J)
02700 C THE ALTITUDE
02800 KJ=0
02810
02900 100 DO 3 L=2,KK
03000 IF(L.EQ.J.OR.NE(L).GT.0)GO TO 3
03100 C NEXT FINDS LINE OVERLAP
03200 CC IF(MISS(L,X,Q,R))3,40,5
03205 IF(MISS(L,X,Q,R))3,40,40
03210 CC5 IF(Q(L).EQ.Q(L-1))GO TO 40
03300 CC IF(POINT(L,Q,R,NE))GO TO 3
03800 C NEXT FINDS ALT. OF CROSSING
03900 40 Y=HGHT(L,X,Q,R)
04000 IF(Y.LT.ALT)KJ=KJ+1
04100 3 CONTINUE
04200 IF(MOD(KJ,2).EQ.0)GO TO 2
04300 C FOUND A LINE TO DRAW LINES DOWN FROM.
04400 NE(J)=-1
05110 CC X=-1
05215 KJ=M
05235 N=Q(J)
05255 L=Q(J-1)
05260 IF(N.LT.L)GO TO 33
05262 KJ=-KJ
05264 N=N-1
05266 GO TO 34
05270 33 N=N+1
05295 34 JA=3
05297 CC X=-1
05299
05300 17 DO 6 K=N,L,KJ
05310 RK=K
05501 Y=HGHT(J,RK,Q,R)
05610 CALL LINES(RK,Y,JA)
05611 CC IF(X)CALL LINES(RK,Y,JA)
05620 JA=2
05700 H=-10000
05800
05900 18 DO 7 I=2,KK
06000 IF(NE(I).NE.0)GO TO 7
06100 C SKIP IF SAME LINE.
06200 IF(MISS(I,RK,Q,R))GO TO 7
06400 C TRY NEXT POINT IF IT HIT A -1 LINE.
07001 9 B=HGHT(I,RK,Q,R)
07100 IF(B.GT.Y)GO TO 7
07200 IF(B.LE.H)GO TO 7
07300 H=B
07500 C FOUND HIGHEST NEW POINT
07510 CC IX=I
07600 7 CONTINUE
07700 IF(H.EQ.Y)GO TO 31
07800 C WIPES OUT THIS LINE SEG.
08200 IF(H.NE.-10000)GO TO 31
08300 CC X=1
08305 GO TO 6
08306 CC31 IF(X)GO TO 32
08308 CC IF(JX.NE.IX)JA=3
08310 CC32 CALL LINES(RK,H,JA)
08311 31 CALL LINES(RK,H,2)
08312 CC JA=2
08314 CC JX=IX
08320 CC IF(X.GT.0)CALL LINES(RK,Y,JA)
08330 CC302 X=-X
08500 6 CONTINUE
08505 IF(JA.EQ.3.OR.K.EQ.L)GO TO 2
08507 IF(H.NE.-10000)CALL LINES(FLOAT(L),HGHT(J,FLOAT(L),Q,R),2)
08510 2 CONTINUE
08600
08700 301 IF(IPLT.EQ.0)CALL DPYOUT(1)
12000 END
13000
13100 FUNCTION HGHT(J,A,Q,R)
13110 DIMENSION Q(1),R(1)
13120 B=R(J-1)
13130 D=Q(J-1)
13140 F=Q(J)
13200 HGHT=((R(J)-B)*(A-D))/(F-D)+B
13250 IF(A.EQ.D)HGHT=B
13300 END
13400
13500 CC FUNCTION POINT(L,Q,R,NE)
13510 CC DIMENSION Q(1),R(1),NE(1)
13600 CC K=L-1
13700 CC N=L+1
13800 CC IF(NE(N).GT.0)N=NE(N)
13900 CC IF(NE(K).GT.0)K=NE(K)
14000 CC POINT=0
14100 CC A=Q(N)
14200 CC B=Q(K)
14300 CC C=Q(L)
14400 CC IF((B.GE.C.AND.A.GE.C).OR.(B.LE.C.AND.A.LE.C))POINT=-1
14500 CC END
14600
14700 FUNCTION MISS(J,A,Q,R)
14800 DIMENSION Q(1),R(1)
14900 B=Q(J)
15000 C=Q(J-1)
15100 MISS=0
15200 IF(B.GT.A)GO TO 1
15300 IF(B.NE.A)GO TO 2
15400 MISS=1
15500 RETURN
15600 2 IF(C.LE.A)GO TO 3
15700 RETURN
15800 1 IF(C.LT.A)RETURN
15900 3 MISS=-1
16000 END
16100 C MISS=-1, HIT=0, POINT=1
16200
16300 FUNCTION HALF(A,J)
16400 DIMENSION A(1)
16500 HALF=(A(J-1)-A(J))/2.+A(J)
16600 RETURN
16700